# $Id: hook.tcl 10 2007-07-29 12:31:39Z khomoutov $

proc normalize_flags {L args} {
	array set flags $args
	set out {}

	set skip 0
	foreach item $L {
		if {$skip} {
			lappend out $item
			set skip 0
		} elseif {[info exists flags($item)]} {
			lappend out $item $flags($item)
		} else {
			lappend out $item
			set skip 1
		}
	}

	set out
}

proc hook {type what script args} {
	switch -glob -- $type {
		command {
			set dest ::HookCommand
		}
		event {
			set dest ::HookEvent
		}
		default {
			return -code error "bad type \"$type\", must be one of command, event"
		}
	}

	set opts [normalize_flags $args -nosubst true]

	eval [list $dest $what $script] $opts
}

proc ProcessStdHookArgs arglist {
	upvar 1 \
		prio _prio

	set _prio 50.0

	foreach {opt val} $arglist {
		switch -glob -- $opt {
			-nosubst { set nosubst true }
	}
}

proc HookCommand {cmd script args} {
	puts [info level 0]

	ProcessStdHookArgs $args
}

proc HookEvent {cmd script args} {
	puts [info level 0]
}

### testbed:

hook command {$Lock} {
	puts {%S %A}
} -sock sock6 -nosubst -gabbahey 1 -prio 60

